home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / rot10.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-21  |  7.7 KB  |  219 lines
  1. {$g+}
  2.  
  3. program bumping_3d_sphere; { 320x200x256 mode }
  4. { Bumping-and-rotating sphere in mode 13h, by Bas van Gaalen, Holland, PD }
  5. const
  6.   dots = 99;
  7.   gseg : word = $a000;
  8.   _x = 0; _y = 1; _z = 2;
  9.   spd = 2;
  10.   dist = 100;
  11.   divd = 1024;
  12.   ptab : array[0..255] of byte = (
  13.     123,121,119,117,115,114,112,110,108,106,104,103,101,99,97,96,94,92,91,
  14.     89,87,86,84,82,81,79,78,76,75,73,72,70,69,67,66,64,63,62,60,59,58,56,
  15.     55,54,52,51,50,49,48,46,45,44,43,42,41,39,38,37,36,35,34,33,32,31,30,
  16.     29,28,27,26,26,25,24,23,22,21,21,20,19,18,17,17,16,15,15,14,13,13,12,
  17.     12,11,10,10,9,9,8,8,7,7,6,6,5,5,5,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,0,0,
  18.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,5,5,6,6,
  19.     7,7,7,8,8,9,9,10,11,11,12,12,13,14,14,15,16,16,17,18,19,19,20,21,22,
  20.     23,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,
  21.     46,47,48,49,51,52,53,54,56,57,58,60,61,62,64,65,67,68,69,71,72,74,75,
  22.     77,78,80,82,83,85,86,88,90,91,93,95,96,98,100,102,103,105,107,109,111,
  23.     113,114,116,118,120,122,124,126);
  24.  
  25. type
  26.   prec = record x,y,z : integer; end;
  27.   ppos = array[0..dots] of prec;
  28.   styp = array[0..255] of integer;
  29.  
  30. var
  31.   stab : styp;
  32.   dot : ppos;
  33.  
  34. {----------------------------------------------------------------------------}
  35.  
  36. procedure setpal(col,r,g,b : byte); assembler;
  37. asm
  38.   mov dx,03c8h
  39.   mov al,col
  40.   out dx,al
  41.   inc dx
  42.   mov al,r
  43.   out dx,al
  44.   mov al,g
  45.   out dx,al
  46.   mov al,b
  47.   out dx,al
  48. end;
  49.  
  50. {----------------------------------------------------------------------------}
  51.  
  52. procedure init;
  53. const
  54.   ctab : array[0..99,_x.._z] of integer = (
  55.     (-18,24,2),(14,-19,19),(23,14,-13),(-1,22,-20),(-3,1,30),(-1,5,30),
  56.     (-11,-27,-4),(-1,0,-30),(-12,-11,25),(-18,-13,20),(-3,12,27),
  57.     (-27,6,-13),(-30,-1,1),(-6,-9,-28),(4,-28,11),(2,22,-20),(-5,1,-30),
  58.     (2,1,30),(-7,21,21),(-7,18,-23),(17,-22,-11),(-10,5,28),(0,-1,30),
  59.     (11,-25,-13),(-6,-28,-10),(13,12,-24),(0,0,-30),(-20,21,8),(-3,-30,-4),
  60.     (16,7,-24),(13,-4,-27),(4,-9,-28),(-10,-1,-28),(-19,-22,-8),(7,-6,29),
  61.     (-16,-22,-13),(23,6,-18),(22,-7,-19),(-5,3,-30),(-3,5,-29),(12,0,28),
  62.     (-6,13,-26),(24,-16,-8),(-7,23,18),(-10,28,-5),(21,20,8),(19,-5,23),
  63.     (0,10,-28),(23,13,-14),(4,-6,29),(19,12,20),(8,-17,-23),(17,21,13),
  64.     (-16,3,25),(-2,4,30),(-24,17,3),(-2,-1,-30),(-9,-8,27),(-10,4,-28),
  65.     (10,-19,21),(3,22,-20),(-6,1,29),(-22,-21,3),(0,-1,-30),(30,1,4),
  66.     (-29,7,-1),(-6,23,-18),(-10,-28,3),(-3,10,-28),(16,-23,-10),
  67.     (-8,23,-17),(-6,3,29),(2,-19,24),(-13,14,-23),(13,-26,9),(-17,21,-12),
  68.     (8,2,29),(16,-13,22),(9,9,27),(7,-15,25),(-25,16,-2),(-1,-3,-30),
  69.     (18,0,-24),(12,-3,27),(3,3,-30),(-22,-16,-13),(-5,-5,29),(21,-14,-16),
  70.     (3,21,21),(21,-20,-8),(27,6,12),(-13,-13,-23),(1,11,-28),(25,-14,-9),
  71.     (3,1,-30),(-2,-3,-30),(1,2,30),(8,20,21),(-20,22,6),(11,13,25));
  72.  
  73. var i : byte;
  74. begin
  75.   for i := 0 to dots do begin
  76.     dot[i].x := ctab[i,_x];
  77.     dot[i].y := ctab[i,_y];
  78.     dot[i].z := ctab[i,_z];
  79.   end;
  80.   for i := 1 to 64 do setpal(i,10+i div 3,10+i div 2,i);
  81. end;
  82.  
  83. {----------------------------------------------------------------------------}
  84.  
  85. procedure csin(var stab : styp); var i : byte; begin
  86.   for i := 0 to 255 do stab[i] := round(sin(2*i*pi/255)*divd); end;
  87.  
  88. {----------------------------------------------------------------------------}
  89.  
  90. function sinus(i : byte) : integer; begin
  91.   sinus := stab[i]; end;
  92.  
  93. {function sinus(i : word) : integer; assembler; asm
  94.   mov di,i; mov ax,word ptr stab[di]; end;}
  95.  
  96. {----------------------------------------------------------------------------}
  97.  
  98. function cosin(i : byte) : integer; begin
  99.   cosin := stab[(i+192) mod 255]; end;
  100.  
  101. {function cosin(i : word) : integer; assembler; asm
  102.   mov di,i; add di,192; mov ax,word ptr stab[di]; and ax,255 end;}
  103.  
  104. {----------------------------------------------------------------------------}
  105.  
  106. function esc : boolean; begin
  107.   esc := port[$60] = 1; end;
  108.  
  109. {----------------------------------------------------------------------------}
  110.  
  111. procedure bumprotate;
  112. const
  113.   xst = spd; yst = spd; zst = -spd; xdiv : shortint = 1;
  114. var
  115.   xp : array[0..dots] of word; { 0 -> 319 }
  116.   yp : array[0..dots] of byte; { 0 -> 199 }
  117.   objx,n : word;
  118.   x,y,z,i,j,k : integer;
  119.   pc,phix,phiy,phiz : byte;
  120.  
  121. begin
  122.   objx := 160; pc := 128; phix := 0; phiy := 0; phiz := 0;
  123.   repeat
  124.  
  125.     asm
  126.       mov dx,03dah
  127.      @l1:
  128.       in al,dx
  129.       test al,8
  130.       jnz @l1
  131.      @l2:
  132.       in al,dx
  133.       test al,8
  134.       jz @l2
  135.     end; { retrace }
  136.  
  137.     setpal(0,15,0,0);
  138.  
  139.     for n := 0 to dots do begin
  140.  
  141.       asm
  142.         mov es,gseg               { put graphicssegment in es }
  143.         mov si,n                  { get index }
  144.         xor ah,ah                 { clear hi-byte }
  145.         mov al,byte ptr yp[si]    { get indexed-value from yp }
  146.         cmp al,200                { check if value greater than 200 }
  147.         jae @skip                 { if so, then jump out }
  148.         shl si,1                  { x2 for word-size }
  149.         mov bx,word ptr xp[si]    { get indexed-value from xp }
  150.         cmp bx,320                { check if value greater than 320 }
  151.         jae @skip                 { if so, then jump out }
  152.         shl ax,6                  { multiply with 64 }
  153.         mov di,ax                 { keep in di }
  154.         shl ax,2                  { multiply with 4 }
  155.         add di,ax                 { add with di (64+(4*64)=320) }
  156.         add di,bx                 { add horizontal value }
  157.         xor al,al                 { al zero (black color) }
  158.         mov [es:di],al            { move to screen }
  159.        @skip:
  160.       end; { check if dot in screen, if so: clear it }
  161.  
  162.       i := (cosin(phiy)*dot[n].x - sinus(phiy)*dot[n].z) div divd;
  163.       j := (cosin(phiz)*dot[n].y - sinus(phiz)*i) div divd;
  164.       k := (cosin(phiz)*dot[n].z + sinus(phiy)*dot[n].x) div divd;
  165.       x := (cosin(phiz)*i + sinus(phiz)*dot[n].y) div divd;
  166.       y := (cosin(phix)*j + sinus(phix)*k) div divd;
  167.       z := (cosin(phix)*k - sinus(phix)*j) div divd;
  168.  
  169.       xp[n] := objx+(-x*dist) div (z-dist);
  170.       yp[n] := 50+ptab[pc]+(-y*dist) div (z-dist);
  171.  
  172.       asm
  173.         mov es,gseg;              { put graphicssegment in es }
  174.         mov si,n                  { get index }
  175.         xor ah,ah                 { clear hi-byte }
  176.         mov al,byte ptr yp[si]    { get indexed-value from yp }
  177.         cmp al,200                { check if value greater than 200 }
  178.         jae @skip                 { if so, then jump out }
  179.         shl si,1                  { x2 for word-size }
  180.         mov bx,word ptr xp[si]    { get indexed-value from xp }
  181.         cmp bx,320                { check if value greater than 320 }
  182.         jae @skip                 { if so, then jump out }
  183.         shl ax,6                  { multiply with 64 }
  184.         mov di,ax                 { keep in di }
  185.         shl ax,2                  { multiply with 4 }
  186.         add di,ax                 { add with di (64+(4*64)=320) }
  187.         add di,bx                 { add horizontal value }
  188.         mov ax,z                  { get z (depth) value }
  189.         shr ax,1                  { divide by 2 (range/2=30) }
  190.         add ax,32                 { add 32, ax is now in range 0 -> 64 }
  191.         mov [es:di],al            { move to screen }
  192.        @skip:
  193.       end; { check if dot in screen, if so: set it }
  194.     end;
  195.  
  196.     inc(objx,xdiv);
  197.     if (objx < 35) or (objx > 285) then xdiv := -xdiv;
  198.  
  199.     inc(pc,spd);
  200.  
  201.     inc(phix,xst);
  202.     inc(phiy,yst);
  203.     inc(phiz,zst);
  204.  
  205.     setpal(0,0,0,0);
  206.  
  207.   until esc;
  208. end;
  209.  
  210. {----------------------------------------------------------------------------}
  211.  
  212. begin
  213.   asm mov ax,13h; int 10h; end;
  214.   init;
  215.   csin(stab);
  216.   bumprotate;
  217.   asm mov ax,3; int 10h; end;
  218. end.
  219.